home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-04
/
aie8911.zip
/
STUBS.ARI
< prev
next >
Wrap
Text File
|
1989-08-27
|
10KB
|
356 lines
%%%%%%%%%% end genned decs %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- extrn stub / 1 : interp.
% :- extrn stub_out / 1 : interp.
:- extrn zzz_turned_off / 1 : interp.
:- extrn stub_trace / 0 : interp.
:- extrn zzz_loop / 0 : interp.
:- visible turn / 2 .
:- visible show / 2 .
stub_trace( X ) :-
call( stub_trace ),
!,
trace_message(X).
stub_trace( _ ).
%%%%%%%%%%%%%%% control of stub use %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
turn( Predicate, on ) :-
retractall( zzz_turned_off( Predicate )),
stub_trace( [ Predicate , $ zzz-retracted$]).
turn( Predicate, off ) :-
asserta( zzz_turned_off( Predicate )),
stub_trace( [ Predicate , $ zzz-asserted$]),
!.
show( Predicate, off) :-
retractall( zzz_displayed( Predicate )),
stub_trace( [ Predicate , $ zzz-un-displayed$]).
show( Predicate, on ) :-
asserta( zzz_displayed( Predicate )),
stub_trace( [ Predicate , $ zzz-displayed$]),
!.
use_the_stub_q( Frame) :-
frame_slot_val( call ,Frame, Call ),
functor( Call, Name, Arity),
current_predicate( Name / Arity ),
!,
stub_trace( [ $b predicate_turned_off$]),
predicate_turned_off( Name / Arity),
stub_trace( [ $b predicate_turned_off$]).
use_the_stub_q( _ ) :- !.
predicate_turned_off( Predicate ) :-
stub_trace( [ $e predicate_turned_off, Pred = $,Predicate]),
fail.
predicate_turned_off( Predicate ) :-
call( zzz_turned_off( Predicate)),
!.
predicate_turned_off( Name / _ ) :-
predicate_turned_off( Name ).
has_stub( Call, Frame) :-
stub( Frame ),
frame_slot_val( call, Frame, Call1 ),
Call1 = Call.
%%%%%%%%%%%%%%% doing the stub %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% trace for debugging
do_stub( Frame ) :-
stub_trace( [ $E do_stub, Frame = : $]),
stub_trace( [ Frame ]),
fail.
% stub execution when stub is a boolean decision
do_stub( Frame ) :-
is_a_boolean( Frame),
!,
yes( question_prompt( Frame) ,
q_means_no,
do_quit ) .
% stub execution when stub is a loop
do_stub( Frame ) :-
is_a_loop( Frame),
stub_trace( [ $I do_stub loop rule $]),
stub_trace( [ $a is_a_loop$]),
!,
do_a_loop( Frame).
% stub execution when stub is an action
do_stub( Frame ) :-
display_purpose( Frame),
!.
%%%%%%%%%%%%%%%%%%% deciding what kind of stub it is %%%%%%%%%%%%%%%%%%%%%
is_a_boolean( Frame ) :-
frame_slot_val( purpose, Frame, Purpose),
boolean_purpose( Purpose ).
is_a_loop( Frame) :-
frame_slot_val( purpose, Frame, Purpose),
loop_description_p( Purpose ).
loop_description_p( Purpose ) :-
singular( Purpose, _).
boolean_purpose( Purpose ) :-
string_search( $decide$, Purpose, _),!.
%%%%%%%%%%%%%%%%%%% doing action stubs %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
display_purpose( Frame ) :-
!,
frame_slot_val( call, Frame, Call ),
frame_slot_val( purpose, Frame, Purpose),
log_write( Call),
log_tab(1),
log_write( Purpose),
log_write($.$),
log_nl.
%%%%%%%%%%%%%%%% boolean processsing %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%% ( and also used for loop exit ) %%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% yes( Question , Q_meaning, Quit_flag )
%
% Displays Question, insists that the user type
% Y or N ( upper or lower case ), and then succeeds
% if user typed Y, or fails if user typed N.
%
%
% Q_meaning = q_means_yes | q_means_no
%
% Quit_flag = do_quit | no_quit
%
% Usual call: yes( Question , q_means_no, do_quit )
%
%
yes( Question , Q_meaning, Quit_flag ) :-
yes_hlpr( Question, Answer),
!,
process_q_answer( Answer, Quit_flag),
answer_means_yes( Answer, Q_meaning).
process_q_answer( q , do_quit ) :-
!,
halt.
process_q_answer( _ , _ ) :- !.
answer_means_yes( yes , _ ) :- !.
answer_means_yes( q , q_means_yes ) :- !.
yes_hlpr( Question, Answer) :-
repeat,
write_question( Question ),
flush,
keyb( Char , Scan),
log_put( Char),
log_nl,
yes_aux( Char, Scan, Answer ).
yes_aux( `Q , _ , q ) :- !. /* Q */
yes_aux( `q , _ , q ) :- !. /* q */
yes_aux( 89 , _ , yes ) :- !. /* Y */
yes_aux( 121 , _, yes ) :- !. /* y */
yes_aux( 78 , _, no ) :- !. /* N */
yes_aux( 110 , _, no ) :- ! . /* n */
yes_aux( 0, 59, _ ) :-
get_specs_help ,
!,
fail.
yes_aux(_, _, _ ) :-
log_put( 7 ), /* beep */
log_write( ' Please enter a "y" for yes or "n" for no.' ),
log_nl,
fail.
write_question( Question ) :-
atomic( Question),
!,
log_write( Question).
write_question( Question ) :-
defined_predicate( Question),
!,
call( Question).
defined_predicate( Question) :-
functor( Question, Name, Arity),
( system( Name / Arity)
; current_predicate( Name / Arity )).
% test( yes) :- yes( $why?$, q_means_yes, do_quit ).
%
%
%%%%%%%%%%%%%%%% end yes and helpers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% generate prompt for boolean question
question_prompt( Frame) :-
frame_slot_val( purpose, Frame, Purpose),
frame_slot_val( call, Frame, Call ),
functor( Call, Name, _),
!,
log_write(Name ),
log_tab(1),
log_write( Purpose),
log_write($.$),
log_nl,
log_write($Is $),
log_write( Call),
log_tab(1),
log_write($true? ( y or n) : $).
/********************* loop processing *****************************/
%%%%%%% executing a loop stub %%%%%%%%%%%%%%%%
do_a_loop( Frame) :-
% get rid of old definitions
stub_trace( [ $e do_a_loop$]),
abolish( zzz_loop / 0),
abolish( zzz_loop_hlpr / 0),
% get purpose of procedure defined in stub
frame_slot_val( purpose, Frame, Purpose),
% get purpose in past form
stub_trace( [ $b done_it_prompt $]),
done_it_prompt( Purpose , Done ),
stub_trace( [ $done_it_prompt = $, Done]),
% get prompt to ask for repeating loop
another_prompt( Purpose , More ),
stub_trace( [ $More_it_prompt = $, More]),
% define question to ask user
Question =
yes( log_write( More ) ,
q_means_no,
do_quit ) ,
stub_trace( [ $Question = $, Question ]),
% define the simulated loop
Loop_rule1 =
(zzz_loop :-
repeat,
zzz_loop_hlpr),
stub_trace( [ $Loop_rule1 = $, Loop_rule1 ]),
assertz( Loop_rule1 ),
/*
Loop_rule2 = zzz_loop,
assertz( Loop_rule2 ),
stub_trace( [ $Loop_rule2 = $, Loop_rule2 ]),
*/
% and the helper functions for the loop
Loop_hlpr_rule1 =
( zzz_loop_hlpr :-
Question,
!,
log_write( Done),
log_nl,
fail),
assertz( Loop_hlpr_rule1 ),
stub_trace( [ $Loop_hlpr_rule1 = $, Loop_hlpr_rule1 ]),
Loop_hlpr_rule2 =
( zzz_loop_hlpr :- ! ),
assertz( Loop_hlpr_rule2 ),
stub_trace( [ $Loop_hlpr_rule2 = $, Loop_hlpr_rule2 ]),
% now execute the loop
stub_trace( [ $b call zzz_loop$]),
call( zzz_loop ).
%%%%%%% NLP FOR LOOP PROCESSING %%%%%%%%%%%%%%
done_it_prompt( Command, Done ) :-
stub_trace( [ $e done_it_prompt, b action$ ]),
action( Command, Action),
!,
stub_trace( [ $b object$ ]),
object( Command, Object),
!,
stub_trace( [ $b singular$ ]),
singular( Object, S_object),
!,
stub_trace( [ $b past, Action = $ , Action ]),
past( Action, Past),
!,
concat([S_object, $ $, Past,$.$], Done).
another_prompt( Command, More ) :-
object( Command, Object),
concat([$More $, Object ,$ (y or n) ? $], More).
action( Command, Action) :-
string_search( $ $, Command, Pos),
substring( Command, 0, Pos, Action).
object( Command, Object) :-
string_search( $ $, Command, Pos),
Pos1 is Pos+1,
string_length( Command, L),
O_lnth is L - Pos1,
substring( Command, Pos1, O_lnth, Object ).
% find past form of verb given present
past( Action, Past) :-
list_text( List, Action), !,
reverse( List, List1), !,
past_hlpr( List1, List2), !,
reverse( List2, List3), !,
list_text( List3, Past).
past_hlpr( [`s, `e | T] , [`d, `e | T] ) :- !.
past_hlpr( [ `e | T] , [`d, `e | T] ) :- !.
past_hlpr( T , [`d, `e | T] ) :- !.
singular( Plural, Singular) :-
string_length( Plural, N),
M is N-1 ,
nth_char(M, Plural, `s),
substring( Plural , 0, M, Singular).
/***************** the test *************************************/
/*
EXAMPLE OF A TEST
test :- do_goal(
process_housing_unit( 1 )
).
*/
/************* end the test *************************************/
%%%%%%%%%%%%%%%%%%%%%%%%%%%% eof %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%